home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IOInterface / event.icl < prev    next >
Encoding:
Modula Implementation  |  1997-04-23  |  1.4 KB  |  66 lines  |  [TEXT/3PRM]
  1. implementation module event;
  2.  
  3. import    StdInt, StdBool;
  4. import    events, desk;
  5. import    commonDef;
  6.  
  7. ::    *EVENTS :==    Int;
  8.  
  9. EventError :: String String -> .x;
  10. EventError f error = Error f "event" error;
  11.  
  12. //    Opening and closing event streams EVENTS from the World:
  13.  
  14. OpenEvents :: !*World -> (!EVENTS, !*World);
  15. OpenEvents world
  16. |    0 == (2 bitand w)    = OpenEvents2 (StoreWorld (w bitor 2) world);
  17.                         = EventError "OpenEvents:" "This world doesn't contain events";
  18.     where {
  19.         w = LoadWorld world;
  20.     };
  21.  
  22. OpenEvents2 :: !* World -> (!EVENTS, !* World);
  23. OpenEvents2 w = code {
  24.         pushI 0
  25.     };
  26.  
  27. LoadWorld :: !World -> Int;
  28. LoadWorld w = code{
  29.     pushI_a    0
  30.     pop_a    1
  31. };
  32.  
  33. StoreWorld :: !Int !World -> * World;
  34. StoreWorld i w =  code {
  35.     fillI_b    0 1
  36.     pop_b    1
  37.     pop_a    1
  38. };
  39.  
  40. CloseEvents :: !EVENTS !*World -> *World;
  41. CloseEvents e world
  42.     =    CloseEvents2 e (StoreWorld (LoadWorld world bitand (-3)) world);
  43.  
  44. CloseEvents2 :: !EVENTS !*World -> *World;
  45. CloseEvents2 e w = code {
  46.         pop_b 1
  47.         fill_a 0 1
  48.         pop_a 1
  49.     };
  50.  
  51. EmptyEVENTS    :: *EVENTS;
  52. EmptyEVENTS    = -1;
  53.  
  54. IsEmptyEVENTS :: EVENTS -> Bool;
  55. IsEmptyEVENTS -1 = True;
  56. IsEmptyEVENTS _ = False;
  57.  
  58. GetEvent :: !Int !Toolbox -> (!Event,!Toolbox);
  59. GetEvent mask tb
  60.     | interesting || what == NullEvent
  61.         = ((interesting,what,message,i,h,v,modifiers), tb1);
  62.         = GetEvent mask (SystemTask tb1);
  63.     where {
  64.         (interesting,what,message,i,h,v,modifiers,tb1) = GetNextEvent mask tb;
  65.     };
  66.